TP 5 - FONCTIONS - CORRIGÉ

Ex1)  Il s'agit de la valeur absolue, de la factorielle, de la suite de Fibonacci, et de la série harmonique.

f[x_]=If[x>0,x,-x];Plot[f[x],{x,-2,2}]

g[n_]:=If[n==1,1,n g[n-1]];g[5]

Comparaison entre la fonction factorielle et la fonction Phi continue affine par morceaux telle que Phi (n) = n! pour n naturel :

Phi[x_]:=Which [x≤1 && x≥0 , 1 ,x≤0 , Phi[x+1]/(x+1) ,True,x Phi[x-1]];Plot[{Phi[x],Factorial[x]},{x,-0.8,3},PlotStyle->{Red,{Blue}}]

h[n_]:=Which[n==0,0,n==1,1,True,h[n-1]+h[n-2]];h[10]

k[n_]:=If[n==1,1,k[n-1]+1/n];k[2]

Rem : une petite modification de la fonction k permet d' obtenir la fonction continue affine par morceaux H telle que si x est entier H (x) = 1 + 1/2 + .. + 1/x :

entier[x_]:=If[IntegerQ[x], x-1 , Floor[x]] ;H[x_]:=If[ x==1,1, H[entier[x]]+(x-entier[x])/(entier[x]+1) ];

Comparaison entre la fonction H et ln + constante d' Euler :

Plot[{H[x],Log[x]+N[EulerGamma]},{x,1,10},PlotStyle->{Red,{Blue}}]

Ex2)

g[x_]=Piecewise[{{-x,x<1},{x,x>0}}]

Plot[g[x],{x,-2,2}]

Piecewise[{{f1[x], cond1}, {f2[x], cond2}}] donne  f1[x] si cond1 est réalisée, et f2[x] si cond2 est réalisée MAIS PAS cond1 !

Ex3) Les impots

impot[r_, n_] :=Which[
r<4121 n,0,
r<8104 n,-309.08 n+0.075 r,
r<14264 n,-1403.12 n+0.21 r,
r<23096 n,-2829.52 n+0.31 r,
r<37579 n,-5139.12 n+0.41 r,
r<46343 n,-7299.91 n+0.4675 r,
True,-10080.49 n+0.5275 r]

Plot3D[impot[r,n],{r,0,200000},{n,1,6}]

Les diverses tranches se recolent de sorte que la fonction impot soit continue

Ex4) Opérateurs de fonctions.

T:=Function[f,Function[x,f[x+1]+f[x]]];
T[f][x]
Composition[T,T][f][x]
Nest[T,f,3][x]

(T^n)(f)(x)=(∑_(k=0)^n)(({{n}, {k}}))f(x+k)

U:=Function[f,Function[x,(f[x/2]+f[(x+1)/2//Expand])/2]]

U[f][x]
Composition[U,U][f][x]//Expand//Factor
Composition[U,U,U][f][x]//Expand//Factor

(U^n)(f)(x)=(1/(2^n))(∑_(k=0)^((2^n)-1))f(((x+k)/(2^n)))

EX5) Diverses formes de la dérivation

f[x_]=x^3;

{(f[x])',f'[x],Derivative[1][f[x]],Derivative[1][f][x],D[f][x],D[f[x],x]}

{(f[x])'',f''[x],Derivative[2][f[x]],Derivative[1][Derivative[1]][f][x],Derivative[2][f][x],D[D[f]][x],D[f[x],x,x]}

Fonctions avec variables locales

Ex6)

Exit

f[a_,b_]:=Module [ {p=1},
Do[If [PrimeQ[k] , p=k p ],{k , a , b}];
p];

Print[f[1,10],"    ",f[10,1]]
p

f (a, b) est le produit des nombres premiers entre a et b, si a <= b.

f=Function[{a,b},p=1;Do[If[PrimeQ[k],p=k p],{k,a,b}];p];
f[1,10]
p

p a pris ici la valeur 210, alors que dans la première version, il est resté vierge.

EX7) Ensemble des diviseurs

diviseurs[n_]:=Module[{d,D={}},
Do[ If[Mod[n ,d]==0 ,D=Union[D,{d,n/d}]] ,{d,Sqrt[n]}];
D];
diviseurs[24]

Timing[ diviseurs[2^40];]

Timing[ Divisors[2^40];]

Une fonction bien plus rapide, proposée par David Cohen, 2010 :

cl[D_,k_] :=Union[D,Table[k*x,{x,D}]]
divisors[n_] := Module[{D={1},u=n,p=2},While[u≠ 1,While[Mod[u,p]==0,{D,u}={cl[D,p],u/p}];p=NextPrime[p]];D]

Timing[Divisors[434654564346848];]

Timing[divisors[434654564346848];]

divisorssimple[n_]:=Module[{D={1},u=n,p=2},While[u≠1,While[Mod[u,p]==0,{D,u}={cl[D,p],u/p}];p++];
D]

Timing[divisorssimple[434654564346848];]

EX8) Somme des cubes des chiffres

f[n_]:=Module[{q=n,s=0},
While[ q>0 ,
s=s+Mod[q,10]^3;
q=Quotient[q,10]];
s]
Print["f(310)=",f[310]]

Do  [If[ f[n]==n, Print[n] ], { n ,1,500}];

EX9) Nombres retournés

f[n_]:=Module[{q=n,m=0},
While[ q>0 ,
m=10 m+Mod[q,10];
q=Quotient[q,10]];
m]
Print["f(310)=",f[310]]

k=0;b=98;While[ b!=f[b], b=f[b]+b;Print[b] ;k++];k

89 est très long à se palindromiser (24 coups), mais 196 l'est encore plus ; 
on pense qu' il ne se palindromise jamais, mais ce fait n'a pas été prouvé.

EX10) Fractions continues

u[n_]:=Module[{ x=a[n],k},
 Do [x=a[k]+1/x ,{k,n-1,0,-1}];
x];
u[5]

Do[a[k]=2 ,{k,0,100}];N[u[100]]

x = 2 + 1/x donc ... ..

Do[a[k]=1,{k,0,100}];N[u[100]]

x = 1 + 1/x donc ... ..

Fonctions récursives

Ex12) Fibonacci avec ou sans mémoire

Sans mémorisation :

F[n_]:=Which[n==0,0,n==1,1,True,F[n-1]+F[n-2]];Timing[F[30]]

Avec mémorisation :

F2[n_]:=F2[n]=F2[n-1]+F2[n-2];F2[0]=0;F2[1]=1;Timing[F2[30]]

Avec transformation en récursivité simple :

F3[n_,a_,b_]:=If[n==0,a,F3[n-1,b,a+b]];Timing[F3[30,0,1]]

Ex13) Triangle de Pascal

Première possibilité : on initialise la première colonne et la diagonale :

c[i_,j_]:=If[Or[j==0,j==i],1 ,c[i-1,j]+c[i-1,j-1]]
n=6;MatrixForm[Table[c[i,j],{i,0,n},{j,0,i}]]

Autre possibilité : on initialise la première ligne :

c[i_,j_]:=Which[{i,j}=={0,0},1,i==0,0,True ,c[i-1,j]+c[i-1,j-1]]
n=6;MatrixForm[Table[c[i,j],{i,0,n},{j,0,i}]]

EX14) Exponentiation rapide.

Algorithme naturel :

exposimple[a_,n_]:=If[n==0,1,a*exposimple[a,n-1]]

exposimple[a,256]

Exponentiation rapide, version récursive :

exporap[a_,n_]:=
Which[ n==0 , 1,EvenQ[n], exporap[a,n/2]^2,True,exporap[a,n-1]a];

Ou bien, en une seule fois :

exporap[a_,n_]:=
If[ n==0 , 1, exporap[a,Quotient[n,2]]^2*a^Mod[n,2]];

Timing[exposimple[444444,251];]

Timing[exporap[444444,251];]

Timing[444444^251;]

exporapplus[a_,n_]:=
Which[ n==0 , 1,EvenQ[n], exporapplus[a,n/2]^2,Mod[n,3]==0, exporapplus[a,n/3]^3,True,exporapplus[a,n-1]a];

Timing[exporapplus[444444,251];]

EX15) Algorithme d'Euclide

pgcd[a_,b_]:=If[b==0,a,pgcd[b,Mod[a,b]]]

pgcd[12, 20]

EX16)  Maximum

maximum[L_]:=If[Length[L]==1 ,L[[1]],Max[L[[1]],maximum[Delete[L,1]]] ]

L={1,8,2,4};maximum[L]

EX17) Tri par insertion

insertion[x_,L_]:=Module[{k=1},While [k≤Length[L] &&x>L[[k] ] ,k++];Insert[L,x,k]]

insertion[4,{1,2,8,9}]

insertion[x, L] insère x après le dernier élément de L qu'il dépasse.

tri[L_]:=If[Length[L]==1,L,insertion[L[[1]],tri[Delete[L,1]]]];
tri[{4,1,2,0,5}]

L=Table[Random[],{k,1,100}];{Timing[tri[L,100];],Timing[Sort[L,Less];]}

EX18) Ensemble des parties d'un ensemble

ajout[x_,Q_]:=Table[X ⋃{x},{X,Q}]
P[E_]:=Module[{ Q,R},
If [E=={} , {{}},
Q=P[Delete[E,1]];R=Q ⋃ajout[E[[1]],Q];
R ]];
P[{"papa","maman","la bonne","moi"}]

Ensemble des parties à p éléments d'un ensemble

P[E_,p_]:=
Which [p==0,{{}},E=={}, {},True,
P[Delete[E,1],p]⋃ajout[E[[1]],P[Delete[E,1],p-1]]];
P[{1,2,3,4,5},3]

Ex19) Liste des permutations d'une liste

ajout[x_,L_]:=Table[Insert[L,x,i],{i,1,Length[L]+1}]
permute[L_]:=If[Length[L]==1,{L},Flatten[Table[ajout[L[[1]],X],{X,permute[Delete[L,1]]}],1]]
permute[{"papa","maman","la bonne","moi"}]